Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/graphics/savbmp/savbmp.frm

Text File | 1996-01-02 | 5KB | 189 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "Form1"
   ClientHeight    =   4356
   ClientLeft      =   552
   ClientTop       =   1428
   ClientWidth     =   7488
   Height          =   4956
   Icon            =   SAVBMP.FRX:0000
   Left            =   504
   LinkTopic       =   "Form1"
   ScaleHeight     =   4356
   ScaleWidth      =   7488
   Top             =   876
   Width           =   7584
   Begin CommandButton Command1
      Caption         =   "Write && Display new bitmap"
      Height          =   375
      Left            =   1320
      TabIndex        =   1
      Top             =   120
      Width           =   2655
   End
   Begin CommonDialog CMDialog1
      CancelError     =   -1  'True
      Filter          =   "bitmaps|*.bmp;*.dib;*.rle"
      Left            =   2160
      Top             =   0
   End
   Begin PictureBox Picture2
      AutoSize        =   -1  'True
      Height          =   855
      Left            =   3720
      ScaleHeight     =   828
      ScaleWidth      =   1428
      TabIndex        =   2
      Top             =   840
      Width           =   1455
   End
   Begin PictureBox Picture1
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   1020
      Left            =   132
      Picture         =   SAVBMP.FRX:0302
      ScaleHeight     =   83
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   172
      TabIndex        =   0
      Top             =   840
      Width           =   2088
   End
   Begin Menu MnuFile
      Caption         =   "File"
      Begin Menu MnuFileOpen
         Caption         =   "Open"
      End
      Begin Menu MnuFileInfo
         Caption         =   "Info..."
      End
      Begin Menu Mnusep
         Caption         =   "-"
      End
      Begin Menu MnuFileExit
         Caption         =   "Exit"
      End
   End
   Begin Menu MnuOptions
      Caption         =   "Options"
   End
End
Option Explicit

'output file name:
Dim bmpfile$
'for the CMDialog:
Const CANCELERR = 32755

Sub Command1_Click ()
  Dim ans As Integer

  'Note: bmpfile$ is set in the form_load routine
  ' to a default "test.bmp" in the app directory
  If Form2!Option2(0) Then
    'Create a disk file monochromatic bitmap
    Call OutputMonoBmp(bmpfile$, Picture1)
  ElseIf Form2!Option2(1) Then
    'Create a disk file 16-color bitmap
    Call Output16Bmp(bmpfile$, Picture1)
  ElseIf Form2!Option2(2) Then
    'Create a disk file 256-color bitmap
    Call Output256Bmp(bmpfile$, Picture1)
  Else
    'Create a disk file 16-million color bitmap
    Call Output24BitBmp(bmpfile$, Picture1)
  End If
  'Display it in the other picture box
  Picture2.ZOrder
  Picture2.Picture = LoadPicture(bmpfile$)

End Sub

Sub Form_Load ()
' keep the options form loaded at all times
  Load Form2
' if picture1 has AutoRedraw, it needn't be visible
  Picture1.AutoRedraw = True
  'set output file name
  bmpfile$ = App.Path & "\test.bmp"

End Sub

Sub Form_Unload (Cancel As Integer)
  Unload Form2
  End
End Sub

Sub MnuFileExit_Click ()
  Unload Me
End Sub

Sub MnuFileInfo_Click ()
  Dim h As Integer
' display info about bmp file
  Dim FileHeader As BITMAPFILEHEADER
  Dim InfoHeader As BITMAPINFOHEADER
  Dim temp$

  On Error GoTo GetOut2
  CMDialog1.Action = 1

  h = FreeFile
  Open CMDialog1.Filename For Binary Access Read As #h
  Get #h, , FileHeader
  Get #h, , InfoHeader
  Close #h
  Form2!Frame2.Visible = False
  Form2.Show
  Form2.CurrentY = TextHeight("X")
  Form2.Print " "; "Width:", , Str$(InfoHeader.biWidth)
  Form2.Print " "; "Height:", , Str$(InfoHeader.biHeight)
  Form2.Print " "; "Planes:", , Str$(InfoHeader.biPlanes)
  Form2.Print " "; "Bits per pixel:", Str$(InfoHeader.biBitCount)
  temp$ = " Uncompressed"
  If InfoHeader.biCompression Then temp$ = " Run-length Encoded"
  Form2.Print " "; "Compression:", temp$
  temp$ = " All"
  If InfoHeader.biClrUsed Then temp$ = Str$(InfoHeader.biClrUsed)
  Form2.Print " "; "Colors Used:", , temp$
  temp$ = " All"
  If InfoHeader.biClrImportant Then temp$ = Str$(InfoHeader.biClrImportant)
  Form2.Print " "; "Colors Important:", temp$

Exit Sub
GetOut2:
If Err <> CANCELERR Then MsgBox Error$(Err)
Exit Sub

End Sub

Sub MnuFileOpen_Click ()
 'load bitmap into picture1
  On Error GoTo GetOut
  CMDialog1.Action = 1
  Picture1.Picture = LoadPicture(CMDialog1.Filename)
  'make sure it's not covered by picture2!
  Picture1.ZOrder
  Exit Sub
GetOut:
If Err <> CANCELERR Then MsgBox Error$(Err)
Exit Sub

End Sub

Sub MnuOptions_Click ()
  Form2.Show 1
End Sub

Sub Picture1_Click ()
' this should ensure that picture1's palette is
' realized when you click on it.
  Picture1.ZOrder
End Sub

Sub Picture2_Click ()
  Picture2.ZOrder
End Sub